
 1000         .LIST OFF
 1010  *---------------------------------
 1020  *      WRITE ASSEMBLY SOURCE ON A TEXT FILE
 1030  *---------------------------------
 1040         .OR $800
 1050  MON.PROMPT .EQ $33
 1060  PP     .EQ $CA,CB
 1070  HIMEM  .EQ $4C,4D
 1080  DOS.RUNFLAG .EQ $D9
 1090  MON.BUFFER .EQ $200
 1100  DOS.BUFFER .EQ $280
 1110  MON.GETLN  .EQ $FD6A
 1120  MON.CROUT  .EQ $FD8E
 1130  MON.COUT   .EQ $FDED
 1140  MON.SETVID .EQ $FE93
 1150  DOS.REHOOK .EQ $3EA
 1160  BLANK.COUNT .EQ $00
 1170  SRCP   .EQ $01,02
 1180  LINNUM .EQ $03,04
 1190  *---------------------------------
 1200  TEXT.LIST
 1210         JSR MON.SETVID
 1220         JSR DOS.REHOOK
 1230         LDA #$FF
 1240         STA DOS.RUNFLAG
 1250         LDA #' +$80  SET PROMPT CHAR = BLANK
 1260         STA MON.PROMPT
 1270  *---------------------------------
 1280  *      GET FILE NAME
 1290  *---------------------------------
 1300         LDY #QFILNAM-QTS
 1310         JSR PRINT.QUOTE
 1320         JSR MON.GETLN
 1330         LDY #$7F     MOVE FILE NAME TO SEPARATE BUFFER
 1340  .1     LDA MON.BUFFER,Y
 1350         STA DOS.BUFFER,Y
 1360         DEY
 1370         BPL .1
 1380  *---------------------------------
 1390  *      SET UP THE TEXT FILE
 1400  *      (CLOSE, OPEN, DELETE, OPEN, WRITE)
 1410  *---------------------------------
 1420         JSR CLOSE.FILE
 1430         LDY #QOPEN-QTS
 1440         JSR ISSUE.DOS.COMMAND
 1450         LDY #QDELETE-QTS
 1460         JSR ISSUE.DOS.COMMAND
 1470         LDY #QOPEN-QTS
 1480         JSR ISSUE.DOS.COMMAND
 1490         LDY #QWRITE-QTS
 1500         JSR ISSUE.DOS.COMMAND
 1510  *---------------------------------
 1520  *      LIST THE SOURCE PROGRAM
 1530  *---------------------------------
 1540         JSR ASM.LIST
 1550  *---------------------------------
 1560  *      CLOSE THE FILE
 1570  *---------------------------------
 1580         JSR CLOSE.FILE
 1590  *---------------------------------
 1600  *      RETURN TO CALLER
 1610  *---------------------------------
 1620         LDA #0
 1630         STA DOS.RUNFLAG
 1640         JMP $1003
 1650  *---------------------------------
 1660  *      MESSAGE TEXT
 1670  *---------------------------------
 1680  QTS    .EQ *
 1690  QCLOSE .AS /CLOSE/
 1700         .HS 8D
 1710  QOPEN  .AS /OPE/
 1720         .AS -/N/
 1730  QDELETE .AS /DELET/
 1740         .AS -/E/
 1750  QWRITE .AS /WRIT/
 1760         .AS -/E/
 1770  QFILNAM .HS 0D
 1780         .AS /TEXT FILE NAME:/
 1790         .AS -/ /
 1800  *---------------------------------
 1810  *      ISSUE DOS COMMAND
 1820  *---------------------------------
 1830  ISSUE.DOS.COMMAND
 1840         LDA #$84     CONTROL-D
 1850         JSR PRINT.CHAR
 1860         JSR PRINT.QUOTE
 1870         LDY #0
 1880         LDA #'       PRINT A SPACE
 1890  .5     JSR PRINT.CHAR
 1900         CMP #$8D
 1910         BEQ .7
 1920         CMP #$AC     COMMA?
 1930         BNE .6
 1940         LDA #$8D
 1950         STA DOS.BUFFER-1,Y
 1960  .6     LDA DOS.BUFFER,Y
 1970         INY
 1980         BNE .5       ...ALWAYS
 1990  .7     RTS
 2000  *---------------------------------
 2010  *      PRINT CHARACTER
 2020  *---------------------------------
 2030  PRINT.CHAR
 2040         PHA
 2050         STY PC.SAVEY
 2060         ORA #$80
 2070         JSR MON.COUT
 2080         LDY PC.SAVEY
 2090         PLA
 2100         RTS
 2110  PC.SAVEY .BS 1
 2120  *---------------------------------
 2130  *      PRINT A QUOTATION
 2140  *---------------------------------
 2150  PRINT.QUOTE.NEXT
 2160         INY
 2170  PRINT.QUOTE
 2180         LDA QTS,Y
 2190         JSR PRINT.CHAR
 2200         BPL PRINT.QUOTE.NEXT
 2210         RTS
 2220  *---------------------------------
 2230  *      CLOSE ALL FILES
 2240  *---------------------------------
 2250  CLOSE.FILE
 2260         JSR MON.CROUT
 2270         LDA #$84
 2280         JSR PRINT.CHAR CONTROL-D
 2290         LDY #QCLOSE-QTS
 2300         JMP PRINT.QUOTE
 2310  *---------------------------------
 2320  *      LIST SOURCE PROGRAM
 2330  *---------------------------------
 2340  ASM.LIST
 2350         LDA PP
 2360         STA SRCP
 2370         LDA PP+1
 2380         STA SRCP+1
 2390  .1     LDA SRCP
 2400         CMP HIMEM
 2410         LDA SRCP+1
 2420         SBC HIMEM+1
 2430         BCS .2       FINISHED
 2440         JSR ASM.LIST.LINE
 2450         JMP .1
 2460  .2     RTS
 2470  *---------------------------------
 2480  *      LIST ONE SOURCE LINE
 2490  *---------------------------------
 2500  ASM.LIST.LINE
 2510         JSR GNB      SKIP OVER BYTE COUNT
 2520         JSR GNB      GET LINE NUMBER
 2530         STA LINNUM
 2540         JSR GNB
 2550         STA LINNUM+1
 2560         JSR PRINT.LINNUM
 2570         LDA #'       BLANK
 2580  .1     JSR PRINT.CHAR
 2590         JSR NEXT.TOKEN
 2600         CMP #0
 2610         BNE .1
 2620         JMP MON.CROUT
 2630  *---------------------------------
 2640  GNB    LDY #0
 2650         STY BLANK.COUNT
 2660         LDA (SRCP),Y
 2670  GNBI   INC SRCP
 2680         BNE .1
 2690         INC SRCP+1
 2700  .1     RTS
 2710  *---------------------------------
 2720  NEXT.TOKEN
 2730         LDY #0
 2740         LDA BLANK.COUNT
 2750         BNE .1
 2760         LDA (SRCP),Y
 2770         BPL GNBI
 2780         AND #$7F
 2790         STA BLANK.COUNT
 2800         JSR GNBI
 2810  .1     DEC BLANK.COUNT
 2820         LDA #'       BLANK
 2830         RTS
 2840  *---------------------------------
 2850  *      PRINT LINE NUMBER
 2860  *---------------------------------
 2870  PRINT.LINNUM
 2880         LDX #3       PRINT 4 DIGITS
 2890  .3     LDA #'0      SET DIGIT TO ASCII ZERO
 2900  .1     PHA          PUSH DIGIT ON STACK
 2910         SEC          SUBTRACT CURRENT DIVISOR
 2920         LDA LINNUM
 2930         SBC PLNTBL,X
 2940         PHA          SAVE BYTE ON STACK
 2950         LDA LINNUM+1
 2960         SBC PLNTBH,X
 2970         BCC .2       LESS THAN DIVISOR
 2980         STA LINNUM+1
 2990         PLA          GET LOW BYTE OFF STACK
 3000         STA LINNUM
 3010         PLA          GET DIGIT FROM STACK
 3020         ADC #0       INCREMENT DIGIT
 3030         BNE .1       ...ALWAYS
 3040  .2     PLA          DISCARD BYTE FROM STACK
 3050         PLA          GET DIGIT FROM STACK
 3060         JSR PRINT.CHAR
 3070         DEX          NEXT DIGIT
 3080         BPL .3
 3090         RTS          RETURN
 3100  *---------------------------------
 3110  PLNTBL .DA #1
 3120         .DA #10
 3130         .DA #100
 3140         .DA #1000
 3150  PLNTBH .DA /1
 3160         .DA /10
 3170         .DA /100
 3180         .DA /1000

